home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / memory.swg / 0026_Writing Data to HiMem.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-08-27  |  4.8 KB  |  175 lines
  1. {
  2. MAX MAISCHEIN
  3.  
  4. > Yes, but my question deals with storage in the Heap - I want to load
  5. > and manipulate as much data in memory as possible.  Hence, I am looking
  6. > for 1 byte improvements, if possible.  The actual file content size is
  7. > not an issue...
  8.  
  9. For the case that some of your machines have UMBs available, I have a unit
  10. that extends the heap into these UMB blocks completely transparent.
  11. THe unit seems to work, I'd like to see any comments about bugs etc. on it.
  12.  
  13.     Max Maischein                                          2:249/6.17
  14.  
  15.     This unit was created to use the  high  memory  under  DOS  where
  16.     LoadHi loads the TSRs etc. as extra heap. This was  possible  due
  17.     to the revamped heap manager of Turbo  Pascal,  which  now  again
  18.     uses MCBs to control its freelist instead of  an  array  of  8192
  19.     pointers. I used this technique just like Himem / Quemm to insert
  20.     a huge used block, the high DOS / BIOS area in the heap and  then
  21.     to add the free RAN behind it. Now I have a maximum heap  size of
  22.     700K, which is nicer than the old 640K  limit.  Note  that  using
  23.     UseHi will not pay attention to the compiler $M settings in  your
  24.     source. The memory is freed automatically by DOS, but  I  had  to
  25.     adjust the MaxHeapxxx variable in the Memory unit, this is a word
  26.     that contains the maximum heap size,  which  increased  by  using
  27.     UseHi. If you don't need Turbo Vision, you can  remove  the  Uses
  28.     Memory line and also remove the MaxHeapxxx adjustment.  But  with
  29.     TVision, it will only work, if you have this line in it.
  30.  
  31.     The text variable HeapWalk is for debugging purposes, if you want
  32.     to see a dump of the free blocks in the heap, you need to  assign
  33.     and reset / rewrite the HeapWalk variable and then call ListWalk.
  34.     Don't forget to close the HeapWalk variable again. It  will  dump
  35.     the whole freelist into the file.
  36.  
  37.     This piece of code is donated to the public domain, but I request
  38.     that, if you use this code, you mention me in the DOCs somewhere.
  39.  
  40.                                                                  -max
  41. }
  42.  
  43. Unit UseHi;
  44. Interface
  45.  
  46. Type
  47.   PFreeRec = ^TFreeRec;
  48.   TFreeRec = Record
  49.     Next   : Pointer;
  50.     Remain : Word;
  51.     Paras  : Word;
  52.   End;
  53.  
  54. Var
  55.   HeapWalk : ^Text;
  56.  
  57. Procedure ListWalk;
  58.  
  59. Var
  60.   NewHeap : Pointer;
  61.   NewSize : Word;
  62.  
  63. Implementation
  64. Uses
  65.   MemAlloc,
  66.   Memory,
  67.   Objects,
  68.   Strings2;
  69.  
  70. Const
  71.   MemStrategy : Word = 0;
  72.   UMBState    : Boolean = False;
  73.  
  74. Procedure himem_Init; Assembler;
  75. Asm
  76.   mov  ax, 5800h
  77.   int  21h
  78.   mov  MemStrategy, ax
  79.   mov  ax, 5802h
  80.   int  21h
  81.   mov  UMBState, al
  82.   mov  ax, 5803h
  83.   mov  bx, 1
  84.   int  21h
  85.   mov  ax, 5801h
  86.   mov  bx, 0040h
  87.   int  21h
  88. End;
  89.  
  90. Procedure himem_Done; Assembler;
  91. Asm
  92.   mov  ax, 5801h
  93.   mov  bx, MemStrategy
  94.   int  21h
  95.   mov  ax, 5803h
  96.   mov  bl, UMBState
  97.   xor  bh, bh
  98.   int  21h
  99.   mov  ax, 1
  100. End;
  101.  
  102. Procedure MakeFreeList;
  103. Var
  104.   Mem : LongInt;      { size of last block between heapPtr / HeapEnd }
  105.   P   : PFreeRec;
  106. Begin
  107.   If (NewHeap = nil) then
  108.     Exit;
  109.  
  110.   P := HeapPtr;
  111.  
  112.   Mem := LongInt(PtrRec(HeapEnd).Seg) shl 4 + PtrRec(HeapEnd).Ofs;
  113.   Dec(Mem, LongInt(PtrRec(HeapPtr).Seg) shl 4 + PtrRec(HeapPtr).Ofs);
  114.  
  115.   If (Mem < 8) then
  116.     RunError(203);
  117.  
  118.   With P^ do
  119.   Begin
  120.     Next   := NewHeap;
  121.     Paras  := Mem shr 4;
  122.     Remain := Mem and $0F;
  123.   End;
  124.  
  125.   HeapPtr := NewHeap;
  126.   HeapEnd := NewHeap;
  127.   With PtrRec(HeapEnd) do
  128.     Inc(Seg, Pred(NewSize));
  129.   MaxHeapSize := PtrRec(HeapEnd).Seg - PtrRec(HeapOrg).Seg;
  130. End;
  131.  
  132. Function BlockSize(P : PFreeRec) : LongInt;
  133. Begin
  134.   With P^ do
  135.     BlockSize := LongInt(Paras) * 16 + LongInt(Remain);
  136. End;
  137.  
  138. Procedure ListWalk;
  139. Var
  140.   P   : PFreeRec;
  141.   Mem : LongInt;
  142. Begin
  143.   WriteLn(HeapWalk^, 'Free list    :', WPointer(FreeList));
  144.   WriteLn(HeapWalk^, 'Heap end     :', WPointer(HeapEnd));
  145.   WriteLn(HeapWalk^, 'Heap pointer :', WPointer(HeapPtr));
  146.   WriteLn(HeapWalk^, 'New heap     :', WPointer(NewHeap));
  147.   WriteLn(HeapWalk^, 'Walk of freelist :' );
  148.   P := FreeList;
  149.   If P <> HeapPtr then
  150.     While P <> HeapPtr do
  151.     Begin
  152.       Write(HeapWalk^, WPointer(Addr(P^)), ' -- ');
  153.       With PtrRec(P), P^ do
  154.         Write(HeapWalk^, WPointer(Ptr(Seg + Paras, Ofs + Remain)));
  155.       WriteLn(HeapWalk^, ', ', BlockSize(P) : 7, ' bytes.');
  156.       P := P^.Next;
  157.     End;
  158.   Mem := LongInt(PtrRec(HeapEnd).Seg) shl 4 + PtrRec(HeapEnd).Ofs;
  159.   Dec(Mem, LongInt(PtrRec(HeapPtr).Seg) shl 4 + PtrRec(HeapPtr).Ofs);
  160.   WriteLn(HeapWalk^, WPointer(HeapPtr), ' -- ', WPointer(HeapEnd), ', ',
  161.                      Mem : 7, ' bytes left on top of heap.');
  162. End;
  163.  
  164. Begin
  165.   NewHeap  := nil;
  166.   HeapWalk := @Output;
  167.  
  168.   himem_Init;
  169.   NewSize := DOSMemAvail shr 4;
  170.   MAlloc(NewHeap, DosMemAvail);
  171.   himem_Done;
  172.  
  173.   MakeFreeList;
  174. End.
  175.